perm filename FILER[NYT,SYS] blob sn#115914 filedate 1974-08-16 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Definitions.  The file DEFS must be assembled with this file.
C00005 00003	Storage allocations.
C00009 00004	FILER
C00012 00005	CHKTEM
C00014 00006	NEWFIL	GETTTY
C00017 00007	END1
C00020 00008	GETCH	PUTCH	PUTSTR
C00022 00009	UUCODE	NXTDG
C00023 00010	CHGNAM	INTRPT
C00025 00011	CONVRT
C00027 00012	FIGS
C00030 00013	SETSHF  CLRSHF  SPE1-7  CKPARA
C00048 ENDMK
C⊗;
;Definitions.  The file DEFS must be assembled with this file.

	TITLE	FILER of AP news

;BUFCNT←←1	;TYPE OUT NUMBER OF CHARS IN EACH BUFFER FROM TTY12

;IFNDEF DEBUG <DEBUG←←0>
IFNDEF BUFCNT <BUFCNT←←0>

TTY12←←1  TTY←←0  DISK←←0  ;EXACTLY ONE OF THESE SHOULD BE NON-ZERO
IFN TTY12*TTY  <TOO MANY INPUT DEVICES!!!!>
IFN TTY12*DISK <TOO MANY INPUT DEVICES!!!!>
IFN TTY  *DISK <TOO MANY INPUT DEVICES!!!!>
IFN TTY12+TTY <BUFLN←←30>
IFN DISK  <BUFLN←←200>

;     ACCUMULATOR ASSIGNMENTS
F←0	;unused
A←1		;TEMPORARY AC
B←2		;TEMPORARY AC
C←3		;CURRENT CHAR
D←4	;unused
E←5		;LF COUNTER--USED TO DETECT END OF STORY

L←6		;LAST CHAR SEEN
M←7		;NUMBER OF COLS OUTPUT SO FAR ON CURRENT LINE
N←10		;NUMBER OF FREE BYTES LEFT IN OUTPUT BUFFER

Q←11	;unused
R←12	;unused

W←13		;W,X,Y,Z ARE USED AS LOOKUP/ENTER BLOCK
X←14
Y←15
Z←16

P←17		;pdl pointer

I←←0		;CHANNEL FOR TTY12 INPUT
T←←1		;CHANNEL FOR OUTPUT TEXT FILE
T1←←2		;CHANNEL FOR LOOKING UP OLD OUTPUT FILE TO SEE IF IT IS GONE
;Storage allocations.

OBUF:	BLOCK	3		;output buffer header
NOBUFS←←3
DSKBUF:	BLOCK	NOBUFS*203	;OUTPUT BUFFER AREA FOR TEXT FILE PASSED TO DOER

IBUF:	BLOCK	3		;input buffer header
NIBUFS←←4
TTYBUF:	BLOCK	NIBUFS*(BUFLN+3)  ;the input buffers for tty12 go here

LPDL←←10
PDL:	BLOCK	LPDL	;area for stack

DSK17:	217		;block used for opening the dsk in mode 17 many times
	SIXBIT	/DSK/	;200 bit means take error return automatically
	0		;if DISK IS FULL or BAD RETRIEVAL

DONAME:	SIXBIT /[DOER]/

DOER:	SIXBIT	/DSK/	;block used to start up DOER
	SIXBIT	/DOER/	;program name goes here
	'DMP',,14	;USE NEW JOB and dont set JLOG
	0		;normal starting address, normal core assignment
PPN:	APPPN
	APPPN

ERRBK:	SIXBIT	/DSK/	;block used to start up error-handling program
	ERRPRG		;program name goes here
	'DMP',,0
	1		;NORMAL CORE SIZE, RPG STARTUP (SA+1)
	APPPN

SHIFT:	0		;flag indicating upper or lower shift characters
CRLF:	ASCIZ	/
/

APNAME:	SIXBIT /[-NY-]/
;FILER

FILER:	RESET
	MOVE	P,[IOWD LPDL,PDL];initialize pdl pointer
	MOVEI	A,INTRPT	;get address of interrupt level module
	MOVEM	A,JOBAPR↑	;store it
	MOVSI	A,INTPTI!INTPAR	;enable interrupts on parity errors
	INTENB	A,		;	and pty input
	MOVSI	A,INTPTI
	INTGEN	A,		;generate a pty input int to set the job name
	MOVE	A,NBRFLR#	;get code indicating number of other filers
	JRST	.+2(A)
	EXIT			;ONE OTHER FILER ALREADY EXISTED
	UFATAL	2		;;;TWO OR MORE OTHER FILERS ALREADY EXISTED

IFN TTY12    <INIT I,411	;grab AP news line, take error return if not avail
	      SIXBIT /TTY13/>
IFN TTY+DISK <INIT I,1     >
IFN TTY      <SIXBIT /TTY/  >
IFN DISK     <SIXBIT /DSK/  >
	IBUF
	UDELAY	2,4		;;;INIT FAILED ON TTY12

	MOVSI	A,000700	;7-BIT BYTES
	MOVEM	A,IBUF+1

	MOVEI	B,TTYBUF	;set up buffers for TTY12 at TTYBUF
	EXCH	B,JOBFF↑
	INBUF	I,NIBUFS
	MOVEM	B,JOBFF		;restore old value of JOBFF

	SETZM	OLDNAM		;ZERO NAME OF PREVIOUS OUTPUT FILE
	SETZM	SHIFT
;CHKTEM

	INIT	T1,210		;LOOK AT UFD FOR A .TEM FILE TO RENAME TO .TFL
	SIXBIT	/DSK/
	OBUF			;ACTUALLY INPUT BUFFER HEADER
	UFATAL	6		;;;CANT INIT DSK

	MOVEI	B,DSKBUF
	EXCH	B,JOBFF↑
	INBUF	T1,NOBUFS
	MOVEM	B,JOBFF

	MOVE	W,PPN
	MOVSI	X,'UFD'
	MOVE	Z,['  1  1']
	LOOKUP	T1,W		;LOOKUP UFD
	UFATAL	10		;;;CANT LOOKUP UFD
	MOVEI	A,2
	MOVNI	B,4
CHKTEM:	IN	T1,
	JRST	CHKTE1
	STATO	T1,20000
	UFATAL	12		;;;DISK INPUT ERROR FROM READING UFD
	PUSHJ	P,CLSUFD	;CLOSE UFD (T1)
	JRST	NEWFIL
CHKTE1:	ILDB	W,OBUF+1	;get filename from UFD
	ILDB	X,OBUF+1	;get extension
	ADDM	A,OBUF+1	;skip last two words of each UFD entry
	HLLZ	X,X
	CAMN	X,['TEM   ']	;is this a .TEM file?
	TDNE	W,[760000,,400000]	;ANY OF THESE BITS ON MEANS CANT BE OURS
	JRST	CHKTE2
	SETZ	Z,		;got one of our .TEM files
	OPEN	T,DSK17
	UFATAL	14		;;;CANT OPEN DSK
	LOOKUP	T,W
	JRST	CHKTE2		;IF CANT OPEN IT, IGNORE IT
	PUSHJ	P,CLSUFD	;CLOSE UFD (T1)
	JRST	END1		;GO RENAME TO .TFL
CHKTE2:	ADDM	B,OBUF+2	;DECREMENT BUFFER HEADER BYTE COUNT
	SKIPLE	OBUF+2		;ANYTHING ELSE IN BUFFER?
	JRST	CHKTE1		;YES
	JRST	CHKTEM

CLSUFD:	RELEAS	T1,
	SETZM	DSKBUF		;CLEAR OUTPUT BUFFERS FOR HOT
	MOVE	A,[DSKBUF,,DSKBUF+1]
	BLT	A,DSKBUF+203*NOBUFS-1
	POPJ	P,
;NEWFIL	GETTTY

NEWFIL:	LOCK	W,		;LOCK JOB IN CORE!

	INIT	T,200		;CREATE A NEW OUTPUT FILE
	SIXBIT	/DSK/
	0
	UFATAL	16		;;;CANT INIT DSK

	ACCTIM	W,		;USE <DATE>,,<TIME> AS FILENAME
	HLRZ	X,W		;GET DATE
	DAYCNT	X,		;CONVERT TO DAYCNT FORMAT
	HRL	W,X
	MOVSI	X,'TEM'
	SETZB	Y,Z
	ENTER	T,W
	AOJA	W,[ENTER T,W	;TRY AT MOST TWICE TO DO AN ENTER
		UDELAY	1,20	;;;CANT ENTER OUTPUT FILE (.TEM)
		JRST .+1]
	MOVEM	W,TEMNAM#	;SAVE NAME OF CURRENT FILE

	INIT	T,200		;RELEASE NEW FILE AND OPEN IN RA MODE
	SIXBIT	/DSK/
	OBUF,,0
	UFATAL	22		;;;CANT INIT DSK

	MOVEI	B,DSKBUF
	EXCH	B,JOBFF↑
	OUTBUF	T,NOBUFS
	MOVEM	B,JOBFF

	SETZ	Z,
	LOOKUP	T,W		;LOOKUP NEW (EMPTY) FILE
	UFATAL	24		;;;CANT LOOKUP NEW OUTPUT FILE
	SETZ	Z,
	ENTER	T,W		;OPEN FOR OUTPUT IN RA MODE
	UFATAL	26		;;;CANT OPEN NEW OUTPUT FILE IN RA MODE

GETTTY:	MOVEI	E,2
GETTT1:	PUSHJ	P,GETCH		;GET AP CHAR AND OUTPUT IT
	CAIE	C,LF		;LOOK FOR 3 STRAIGHT LFs
	MOVEI	E,3		;HAVEN'T SEEN ANY YET
	SOJGE	E,GETTT1
;END1

	MOVEI	C,200		;MAKE SURE STORY ENDS WITH NULL
	PUSHJ	P,PUTCH
	OUT	T,		;PUT OUT LAST PARTIAL BUFFER
	AOSA	OBUF+2		;KEEP BYTE COUNT ACCURATE
	UFATAL	30		;;;OUT UUO FAILED TO OUTPUT LAST RECORD OF STORY
	MTAPE	T,[SIXBIT/GODMOD/↔17]	;AND UPDATE RETRIEVAL

	OPEN	T1,DSK17
	UFATAL	32		;;;CANT OPEN DSK
	MOVE	W,OLDNAM#
	MOVSI	X,'TFL'
	SETZB	Z,C
	LOOKUP	T1,W		;LOOK FOR PREVIOUS OUTPUT FILE
	SETO	C,		;APPARENTLY NOT THERE
	RELEAS	T1,
	JUMPE	C,END2		;PREVIOUS FILE STILL THERE.  DONT START NEW FILE

	CLOSE	T,		;PREVIOUS FILE GONE.  CLOSE CURRENT FILE.
	MOVE	W,TEMNAM#	;GET NAME OF CURRENT OUTPUT FILE
END1:	MOVSI	X,'TFL'
	SETZB	Y,Z
	RENAME	T,W		;RENAME .TFL←.TEM
	UFATAL	34		;;;CANT RENAME TEM FILE TO TFL
	RELEAS	T,
	MOVEM	W,OLDNAM	;SAVE NAME OF THIS FILE

END2:	MOVEI	B,DOER		;think about starting up DOER
	MOVE	A,DONAME	;see if a DOER job exists
	NAMEIN	A,
	ORI	A,400		;NOTE THAT NAMEIN FAILED (NO UNIQUE DOER)
	CAIN	A,401		;CHECK ERROR CODE
	SWAP	B,		;NO DOERS.  START ONE UP
	JUMPE	C,GETTTY	;NO NEW FILE YET
	JRST	NEWFIL		;GO OPEN A NEW OUTPUT FILE
;GETCH	PUTCH	PUTSTR

GETCH:	SOSLE	IBUF+2		;ANY CHARS IN INPUT BUFFER
	JRST	GETCH1		;YES.  GET ONE.
	IN	I,		;NO.  GET NEW BUFFER
	JRST	GETCH2
IFN TTY+DISK <
	STATZ	I,20000		;END OF FILE?
	EXIT			;YES
>;END IFN TTY+DISK
	UFATAL	36		;;;INPUT ERROR FROM TTY12

GETCH2:
IFN TTY12+TTY <
	MOVE	A,IBUF+2	;GET NUMBER OF CHARS IN BUFFER
IFN TTY12 <
IFN BUFCNT <
	PUSHJ	P,NXTDG
	OUTCHR	[" "]
	MOVE	A,IBUF+2
>;END IFN BUFCNT
>;END IFN TTY12
	CAIGE	A,5*BUFLN
	JRST	GETCH1		;NOT FULL BUFFER
	MOVEI	A,[ASCIZ/...
/]				;FULL BUFFER--ASSUME WE MISSED SOME CHARS
	PUSHJ	P,PUTSTR	;INSERT "...CRLF"
>;END IFN TTY12+TTY

GETCH1:	ILDB	C,IBUF+1
IFN TTY12 <
	TRNE	C,140
	JRST	[MOVEI C,"%"	;140 BIT(S) ON IN AP-LINE CHAR
		JRST PUTCH]	;PUT OUT FUNNY CHAR
	ADD	C,SHIFT		;ACCOUNT FOR CURRENT SHIFT SETTING
	XCT	CONVRT(C)	;CONVERT FROM AP CODE TO ASCII
>;END IFN TTY12
	JUMPE	C,GETCH		;FALL INTO PUTCH IF NOT NULL CHAR

PUTCH:	SOSG	OBUF+2		;ANY ROOM LEFT IN OUTPUT BUFFER?
	OUT	T,		;NO.  WRITE OUT BUFFER
	JRST	PUTCH1
	UFATAL	40		;;;DISK OUTPUT ERROR
PUTCH1:	IDPB	C,OBUF+1
	POPJ	P,

PUTSTR:	TLOA	A,440700	;MAKE A BYTE POINTER
PUTST1:	PUSHJ	P,PUTCH
	ILDB	C,A
	JUMPN	C,PUTST1
	POPJ	P,
;UUCODE	NXTDG

UUCODE:	0
halt .+1
	SETO	A,
	GETLIN	A
	AOJE	A,DET
	OUTSTR	[ASCIZ /
FILER error #/]
	HRRZ	A,40		;get error number
	PUSHJ	P,NXTDG		;TYPE OUT ERROR NUMBER
	EXIT	1,
	HALT	.
	JRST	@UUCODE

DET:	RESET
	MOVE	1,APNAME	;PASS JOB NAME IN AC 1
	MOVE	2,40		; AND ERROR UUO IN AC 2
	MOVEI	16,ERRBK
	SWAP	16,
	EXIT

NXTDG:	IDIVI	A,=8		;convert number in A to octal ASCII string
	HRLM	B,(P)
	JUMPE	A,.+2
	PUSHJ	P,NXTDG
	HLRZ	A,(P)
	ADDI	A,"0"
	OUTCHR	A
	POPJ	P,
;CHGNAM	INTRPT

;interrupt level routine to set the job name
CHGNAM:	SETZ	A,			;zero out own job name
	SETNAM	A,
	SETOM	NBRFLR#			;initialize indicator to one other filer
	MOVE	A,APNAME		;get filer's name from wakeme block
	NAMEIN	A,
	JRST	.+2			;zero or multiple filers exist
	DISMIS				;one other filer exists
	SETZM	NBRFLR			;set indicator to multiple filers
	CAIE	A,1			;check error code of NAMEIN
	DISMIS				;two or more other filers exist
	AOS	NBRFLR			;set indicator to no other filers
	MOVE	A,APNAME		;change job name
	SETNAM	A,
	MOVEI	A,200000
	INTACM	A,			;disable for further pdl ov ints
	DISMIS

;interrupt level module
INTRPT:	MOVSI	C,INTPAR	;enable interrupts only on parity errors
	INTENB	C,
	MOVS	A,JOBCNI↑	;get bit causing interrupt
	CAIN	A,INTPTI	;is this interrupt to set filer's job name?
	JRST	CHGNAM		;yes.  do it
	CAIE	A,INTPAR
	DISMIS			;IGNORE STRANGE INTERRUPT
	UWAIT			;PARITY ERROR.  GIVE UP AND GO HOME
	JRST	2,@[.+1]	;get out of user-iot
	DEBREAK
	EXIT			;PARITY ERROR IN FILER
;CONVRT
;LETTERS
CONVRT:	JRST	GETCH		;0: tape feed
	MOVEI	C,"E"	;1
	MOVEI	C,LF		;2: elevate→line feed
	MOVEI	C,"A"	;3
	MOVEI	C," "		;4: SPACE.
	MOVEI	C,"S"	;5
	MOVEI	C,"I"	;6
	MOVEI	C,"U"	;7
	MOVEI	C,CR		;10: CARRIAGE RETURN
	MOVEI	C,"D"	;11
	MOVEI	C,"R"	;12
	MOVEI	C,"J"	;13
	MOVEI	C,"N"	;14
	MOVEI	C,"F"	;15
	MOVEI	C,"C"	;16
	MOVEI	C,"K"	;17
	MOVEI	C,"T"	;20
	MOVEI	C,"Z"	;21
	MOVEI	C,"L"	;22
	MOVEI	C,"W"	;23
	MOVEI	C,"H"	;24
	MOVEI	C,"Y"	;25
	MOVEI	C,"P"	;26
	MOVEI	C,"Q"	;27
	MOVEI	C,"O"	;30
	MOVEI	C,"B"	;31
	MOVEI	C,"G"	;32
	JRST	SETSHF		;33: SHIFT
	MOVEI	C,"M"	;34
	MOVEI	C,"X"	;35
	MOVEI	C,"V"	;36
	JRST	CLRSHF		;37: UNSHIFT
;FIGS
	JRST	GETCH		;00
	MOVEI	C,"3"	;01
	MOVEI	C,LF		;02: PAPER FEED→LINE FEED
	MOVEI	C,"-"	;43
	MOVEI	C," "		;SPACE
	JRST	GETCH		;05: BELL
	MOVEI	C,"8"	;46
	MOVEI	C,"7"	;47
	MOVEI	C,CR	;50
	MOVEI	C,"$"	;51
	MOVEI	C,"4"	;52
	MOVEI	C,47		;13: SINGLE QUOTE
	MOVEI	C,","	;54: comma
	MOVEI	C,"!"	;55: EXCLAMATION POINT
	MOVEI	C,":"	;16: COLON
	MOVEI	C,"("	;17: LEFT PAREN
	MOVEI	C,"5"	;60
	MOVEI	C,42	
	MOVEI	C,")"	;61
	MOVEI	C,"2"	;63
	JRST	GETCH		;64
	MOVEI	C,"6"	;65
	MOVEI	C,"0"	;66
	MOVEI	C,"1"	;75
	MOVEI	C,"9"	;70
	MOVEI	C,"?"	;72
	MOVEI	C,"&"	;74
	JRST	SETSHF	;SHIFT
	MOVEI	C,"."	;PERIOD
	MOVEI	C,"/"
	MOVEI	C,";"
	JRST	CLRSHF
;SETSHF  CLRSHF  SPE1-7  CKPARA

CLRSHF:	TDZA	C,C
SETSHF:	MOVEI	C,40
	MOVEM	C,SHIFT
	JRST	GETCH

	END	FILER